home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / tjgold.zip / INSTALL.002 / GTTTREAD.PAS < prev   
Pascal/Delphi Source File  |  1995-07-12  |  33KB  |  1,017 lines
  1. {--------------------------------------------------------------------------}
  2. {                Product: TechnoJock's Turbo Toolkit                       }
  3. {                Version: GOLD                                             }
  4. {                Build:   1.01                                             }
  5. {                                                                          }
  6. {                Copyright 1986-1995  TechnoJock Software, Inc.            }
  7. {                           All Rights Reserved                            }
  8. {                          Restricted by License                           }
  9. {--------------------------------------------------------------------------}
  10.  
  11.                     {**********************************}
  12.                     {**       Unit:   GTTTREAD       **}
  13.                     {**********************************}
  14.  
  15. {$S-,R-,V-}
  16. {$IFNDEF DEBUG}
  17.    {$D-}
  18. {$ENDIF}
  19.  
  20. Unit GTTTREAD;
  21.  
  22. Interface
  23.  
  24. uses CRT, GoldAttr, GoldFast, GoldWin, GoldStr, GoldKey, GoldHard;
  25.  
  26. type
  27.    RDisplay = record
  28.       WhiteSpace: char;       {used to pad input field - default ··········}
  29.       AllowEsc: boolean;      {allow the he user to escape?}
  30.       Beep: boolean;          {allow the old proverbial beep}
  31.       Insert: boolean;        {initially in insert mode?}
  32.       BegCursor: boolean;     {place cursor at beginning of line}
  33.       AllowNull: boolean;     {allow user to input a '' or null value}
  34.       RightJustify: boolean;  {right justify string on termination}
  35.       EraseDefault: boolean;  {clear entry of alphanumeric pressed}
  36.       SuppressZero: boolean;  {have empty field is value = zero}
  37.       FCol: byte;             {normal foreground color of input field}
  38.       BCol: byte;             {normal background of input field}
  39.       HiFCol: byte;           {highlighted fgnd color for ReadSelect}
  40.       HiBCol: byte;           {highlighted bgnd color for ReadSelect}
  41.       LoFCol: byte;           {normal fgnd color for ReadSelect}
  42.       LoBCol: byte;           {normal bgnd color for ReadSelect}
  43.       PFcol: byte;            {prompt foreground color}
  44.       PBCol: byte;            {prompt background color}
  45.       BoxFCol: byte;          {box foreground color}
  46.       BoxBCol: byte;          {Box background color}
  47.       MsgFCol: byte;          {Foreground color for error messages}
  48.       MsgBCol: byte;          {Background color for error messages}
  49.       MsgLine: byte;          {line for error messages}
  50.       Endchars: set of char;  {end of input chars}
  51.       RealDP: byte;           {no of decimal places on real}
  52.    end;
  53.  
  54. const NoPrompt:string[1] = '';
  55.  
  56. var   RTTT: RDisplay;
  57.       RChar: char;
  58.       RNull: boolean;
  59.  
  60. procedure DefaultSettings;
  61. procedure ReadLine(X,Y,L,F,B,Format: byte; var Text: string);
  62. procedure ReadString(X,Y,L: byte; Prompt: StrScreen; BoxType: byte;
  63.                                        var Txt: StrScreen);
  64. procedure ReadStringUpper(X,Y,L: byte; Prompt: StrScreen; BoxType: byte;
  65.                                        var Txt: StrScreen);
  66. procedure ReadPassword(X,Y,L: byte; Prompt: StrScreen; BoxType: byte;
  67.                                        var Txt: StrScreen);
  68. procedure ReadAlpha(X,Y,L: byte; Prompt: StrScreen; BoxType: byte;
  69.                                        var Txt: StrScreen);
  70. procedure ReadYN(X,Y: byte; Prompt: StrScreen; BoxType: byte;
  71.                                        var Yes:Boolean);
  72. procedure ReadByte(X,Y,L: byte; Prompt: StrScreen; BoxType: byte;
  73.                                        var B : byte; Min, Max: byte);
  74. procedure ReadWord(X,Y,L: byte; Prompt: StrScreen; BoxType: byte;
  75.                                        var W: word; Min, Max: word);
  76. procedure ReadInt(X,Y,L: byte; Prompt: StrScreen; BoxType: byte;
  77.                                        var W: integer; Min, Max: integer);
  78. procedure ReadLongInt(X,Y,L: byte; Prompt: StrScreen; BoxType: byte;
  79.                                        var W: longint; Min, Max: longint);
  80. procedure ReadReal(X,Y,L: byte; Prompt: StrScreen; BoxType: byte;
  81.                                        var W: real; Min, Max: real);
  82. procedure ReadSelect(X,Y: byte;Pmt,Txt: StrScreen;var Choice: byte);
  83.  
  84. Implementation
  85.  
  86. const
  87.     PassChar    = #15;
  88.     CursorRight = #205;
  89.     CursorLeft  = #203;
  90.     CursorDown  = #208;
  91.     CursorUp    = #200;
  92.     EnterKey    = #13;
  93.     EscKey      = #27;
  94.     EndKey      = #207;
  95.     HomeKey     = #199;
  96.     DelKey      = #211;
  97.     Backspace   = #8;
  98.     InsKey      = #210;
  99.     Zap         = #160;      {Alt D to delete the field}
  100.     MinInt      = -32768;
  101.     MaxLongInt:longint  =  2147483647;
  102.     MinLongInt:longint  = -2147483647;
  103.     MaxWord             =  65535;
  104.     MinWord             =  0;
  105.  
  106. var
  107.    CursorX,
  108.    CursorY,
  109.    ScanTop,
  110.    ScanBot: byte;
  111.  
  112. procedure DefaultSettings;
  113. begin
  114.    with RTTT do
  115.    begin
  116.       WhiteSpace := #250;
  117.       Beep := true;
  118.       BegCursor := false;
  119.       Insert := false;
  120.       AllowEsc := true;
  121.       AllowNull := true;
  122.       RightJustify := false;
  123.       EraseDefault := false;
  124.       SuppressZero := true;
  125.       EndChars := [#13,#133];  {Enter}
  126.       RealDP := 2;
  127.       if not ColorScreen then
  128.       begin
  129.          FCol := black;
  130.          BCol := lightgray;
  131.          HiFCol := white;
  132.          HiBCol := black;
  133.          LoFCol := lightgray;
  134.          LoBCol := black;
  135.          PFCol := white;
  136.          PBCol := black;
  137.          BoxFCol := white;
  138.          BoxBCol := black;
  139.          MsgFCol := white;
  140.          MsgBCol := black;
  141.          MsgLine := 0;
  142.       end else
  143.       begin
  144.          FCol := black;
  145.          BCol := lightgray;
  146.          HiFCol := black;
  147.          HiBCol := lightgray;
  148.          LoFCol := lightgray;
  149.          LoBCol := black;
  150.          PFCol := white;
  151.          PBCol := black;
  152.          BoxFCol := white;
  153.          BoxBCol := black;
  154.          MsgFCol := lightred;
  155.          MsgBCol := black;
  156.          MsgLine := 0;
  157.       end;
  158.    end;
  159. end; { DefaultSettings }
  160.  
  161. procedure Clang;
  162. {}
  163. begin
  164.    if RTTT.Beep then
  165.    begin
  166.       sound(500);
  167.       delay(50);
  168.       nosound;
  169.    end;
  170. end; { Clang }
  171.  
  172. procedure ReadLine(X,Y,L,F,B,Format: byte; var Text: string);
  173. {
  174. X is X coord of first character in field
  175. Y is Y coord of field
  176. L is the maximum length of the input field
  177. F is the foreground color
  178. B is the background color
  179. Format Codes:      1   Any String
  180.                    2   Force Upper String
  181.                    3   Yes/No
  182.                    4   Alphabetics only
  183.                    5   Integer
  184.                    6   LongInteger
  185.                    7   Real
  186.                    8   Word
  187.                    11  Echo a Password
  188. Text is a string updated with the string equivalent of user input
  189. }
  190. var
  191.     TempText: string;
  192.     CursorPos: byte;
  193.     InsertMode,
  194.     Password,
  195.     Alldone: boolean;
  196.     FirstCharPress: boolean;
  197.     Ch: char;
  198.  
  199.     procedure CheckParameters;
  200.     begin
  201.        TempText := Text;
  202.        if length(TempText) > L then
  203.           Delete(Temptext,L+1,length(TempText)-L);
  204.        if not X in [1..80] then
  205.           X := 1;
  206.        if X + L - 1 > 80 then
  207.           X := 81 - L;
  208.        if not Y in [1..25] then
  209.           Y := 1;
  210.        if RTTT.BegCursor then
  211.           CursorPos := 1
  212.        else
  213.        begin
  214.           if length(TempText) < L then
  215.              CursorPos := length(TempText) + 1
  216.           else
  217.              CursorPos := length(TempText);
  218.        end;
  219.        InsertMode := RTTT.Insert;
  220.        Alldone := False;
  221.        if Format = 11 then
  222.        begin
  223.           Password := true;
  224.           Format := 1;
  225.        end else
  226.           Password := false;
  227.     end;  { CheckParameters }
  228.  
  229.     function FillWhiteSpace(Str: string): string;
  230.     var I : integer;
  231.     begin
  232.        if Password then
  233.           Str := replicate(length(Str),PassChar);
  234.        while length(Str) < L do
  235.              Str := Str + RTTT.WhiteSpace;
  236.        FillWhiteSpace := Str;
  237.     end; { FillWhiteSpace }
  238.  
  239.     procedure MoveTheCursor;
  240.     begin
  241.        GotoXY(X+CursorPos-1,Y);
  242.     end;  { MoveTheCursor }
  243.  
  244.     procedure WriteString;
  245.     begin
  246.        WriteAT(X,Y,Cattr(F,B),FillWhiteSpace(TempText));
  247.        MoveTheCursor;
  248.     end; { WriteString }
  249.  
  250.     procedure EraseField;
  251.     begin
  252.        TempText := '';
  253.        CursorPos := 1;
  254.        WriteString;
  255.     end; { EraseField }
  256.  
  257.     procedure CharBackspace;
  258.     begin
  259.        if CursorPos > 1 then
  260.        begin
  261.           CursorPos := Pred(CursorPos);
  262.           Delete(TempText,CursorPos,1);
  263.           WriteString;
  264.        end;
  265.     end; { CharBackspace }
  266.  
  267.     procedure CharDel;
  268.     begin
  269.        if CursorPos <= length(TempText) then
  270.        begin
  271.           Delete(TempText,CursorPos,1);
  272.           WriteString;
  273.        end;
  274.     end;   { CharDel }
  275.  
  276.     procedure AddChar(Ch:char);
  277.     begin
  278.        if InsertMode then
  279.        begin
  280.           if length(TempText) < L then
  281.           begin
  282.              Insert(Ch,TempText,CursorPos);
  283.              if CursorPos < L then
  284.                 CursorPos := Succ(CursorPos);
  285.           end;
  286.        end else {not insertmode}
  287.        begin
  288.           delete(TempText,CursorPos,1);
  289.           insert(Ch,TempText,CursorPos);
  290.           if CursorPos < L then
  291.              CursorPos := Succ(CursorPos);
  292.        end;   {if insert}
  293.        WriteString;
  294.     end;   { AddChar }
  295.  
  296. begin                  {main Procedure ReadLine}
  297.    CheckParameters;
  298.    RNull := false;
  299.    CursorFind(CursorX,CursorY,ScanTop,ScanBot);
  300.    if RTTT.Insert then
  301.       CursorHalf
  302.    else
  303.       CursorOn;
  304.    WriteString;
  305.    FirstCharPress := true;
  306.    repeat
  307.       Ch := Getkey;
  308.       if Format in [2,3] then
  309.          Ch := upcase(Ch);
  310.       if Ch in RTTT.EndChars then
  311.       begin
  312.          AllDone := True;
  313.          if Ch <> #027 then
  314.             Text := TempText;
  315.       end else
  316.       begin
  317.          Case Ch of
  318.             #131,              {mouseright}
  319.             CursorRight   : begin
  320.                                if (CursorPos < L)
  321.                                and (CursorPos <= length(TempText)) then
  322.                                begin
  323.                                   CursorPos := Succ(CursorPos);
  324.                                   MoveTheCursor;
  325.                                end;
  326.                             end;
  327.             #130,               {mouseleft}
  328.             CursorLeft    : begin
  329.                                if CursorPos > 1 then
  330.                                begin
  331.                                   CursorPos := Pred(CursorPos);
  332.                                   MoveTheCursor;
  333.                                end;
  334.                             end;
  335.             HomeKey       : begin
  336.                                CursorPos := 1;
  337.                                MoveTheCursor;
  338.                             end;
  339.             EndKey        : begin
  340.                                if CursorPos < L then
  341.                                if length(TempText) < L then
  342.                                    CursorPos := length(TempText) + 1
  343.                                else
  344.                                    CursorPos := L;
  345.                                MoveTheCursor;
  346.                             end;
  347.              InsKey       : if Format <> 3 then   {don't allow insert on Y/N!}
  348.                             begin
  349.                                InsertMode := not InsertMode;
  350.                                if InsertMode then
  351.                                   CursorHalf
  352.                                else
  353.                                   CursorOn;
  354.                             end;
  355.              DelKey       : CharDel;
  356.              Zap          : EraseField;
  357.              #132,
  358.              EscKey       : if RTTT.AllowEsc then
  359.                                Alldone := true
  360.                             else
  361.                                Clang;
  362.              #133         : begin
  363.                                Alldone := true;
  364.                                Text := TempText;
  365.                             end;
  366.              #128,#129    : ; {absorb stray mouse movement to avoid Clang'n}
  367.              BackSpace    :  CharBackspace;
  368.              EnterKey     :  begin
  369.                                 Alldone := true;
  370.                                 Text := TempText;
  371.                              end;
  372.             #33 .. #42,                                 {! to *}
  373.             #44,#47,                                    {, /}
  374.             #58 .. #64,                                 {: to @}
  375.             #91 .. #96,                                 {[ to '}
  376.             #123 .. #126  : if (Format in [1,2]) then {{ to ~}
  377.                             begin
  378.                                if FirstCharPress and RTTT.EraseDefault then
  379.                                   EraseField;
  380.                                AddChar(Ch);
  381.                             end else
  382.                                Clang;
  383.             #43, #45      : if (Format in [1,2])       { + - }
  384.                             or ( (CursorPos=1) and (Format in [5,6,7])) then
  385.                             begin
  386.                                if FirstCharPress and RTTT.EraseDefault then
  387.                                   EraseField;
  388.                                AddChar(Ch);
  389.                             end else
  390.                                Clang;
  391.             #46           : if (Format in [1,2])       {.}
  392.                             or ( (Pos('.',TempText)=0) and (Format = 7)) then
  393.                             begin
  394.                                if FirstCharPress and RTTT.EraseDefault then
  395.                                   EraseField;
  396.                                AddChar(Ch);
  397.                             end else
  398.                                Clang;
  399.             #48..#57      : if (Format in [1..2,5..8]) then {0 to 9}
  400.                             begin
  401.                                if FirstCharPress and RTTT.EraseDefault then
  402.                                   EraseField;
  403.                                AddChar(Ch);
  404.                             end else
  405.                                Clang;
  406.             #32,                                              {space}
  407.             #65..#77,                                         {A to M}
  408.             #79..#88,                                         {O to X}
  409.             #90,                                              {Z}
  410.             #97..#255     : if (Format in [1,2,4]) then      {a to z}
  411.                             begin
  412.                                if FirstCharPress and RTTT.EraseDefault then
  413.                                   EraseField;
  414.                                AddChar(Ch);
  415.                             end else
  416.                                Clang;
  417.             #78,#89       : if (Format in [1..4]) then        {N Y}
  418.                             begin
  419.                                AddChar(Ch);
  420.                                if Format = 3 then
  421.                                begin
  422.                                   Alldone := true;
  423.                                   Text := TempText;
  424.                                end;
  425.                             end else
  426.                                Clang;
  427.          end; {case}
  428.       end;
  429.       FirstCharPress := false;
  430.    until Alldone;
  431.    RChar := Ch;
  432.    if  RTTT.RightJustify
  433.    and (Format > 4) then
  434.    begin
  435.       WriteAT(X,Y,Cattr(F,B),replicate(L,RTTT.Whitespace));
  436.       WriteAT(X+L-Length(TempText),Y,Cattr(F,B),Text);
  437.    end else
  438.    WriteAT(X,Y,Cattr(F,B),FillWhiteSpace(Text));
  439.    GotoXY(CursorX,CursorY);
  440.    CursorSize(ScanTop,ScanBot);
  441. end;  { ReadLine }
  442.  
  443. procedure DisplayBoxAndPrompt(var X1,Y: byte; BoxType: byte;
  444.                                  Prompt: StrScreen; L: byte);
  445. {ensures that the input will fit on the screen, then draws box and prompt}
  446. const
  447.     Upchar = '^';
  448.     DnChar = '';
  449. var P, width: byte;
  450.     InBorder: byte;    {is title in box border - 0 no, 1 upper, 2 lower}
  451. begin
  452.    if not ( (Y-ord(BoxType > 0)) in [1..HardVars.Depth] ) then
  453.       Y := 2;
  454.    if (X1 < 1) then
  455.       X1 := 2;
  456.    P := length(Prompt);
  457.    if (P > 1) and (Boxtype > 0) then    {check and see if prompt is in box}
  458.    begin
  459.       if Prompt[1] = Upchar then
  460.       begin
  461.          delete(Prompt,1,1);
  462.          dec(P);
  463.          InBorder := 1;
  464.       end else
  465.       if Prompt[1] = DnChar then
  466.       begin
  467.          delete(Prompt,1,1);
  468.          dec(P);
  469.          InBorder := 2;
  470.       end else
  471.       InBorder := 0;
  472.    end else
  473.    InBorder := 0;
  474.    if InBorder > 0 then                      {determine dimensions of box}
  475.    begin
  476.       if P > L then
  477.          width := succ(P)
  478.       else
  479.          width := succ(L);
  480.    end else
  481.    width := succ(P+l);
  482.    if pred(X1 + width) > 80 then
  483.       X1 :=  succ(80 - width);
  484.    if BoxType > 0 then         {draw the box}
  485.       FBox(X1,pred(Y),X1+width,succ(Y),Cattr(RTTT.BoxFCol,RTTT.BoxBCol),BoxType);
  486.    if P > 0 then               {Draw the prompt}
  487.    case InBorder of
  488.       0 : if BoxType> 0 then
  489.              WriteAT(succ(X1),Y,Cattr(RTTT.PFcol,RTTT.PBCol),Prompt) {left Justified in upper border}
  490.           else
  491.              WriteAT(X1,Y,Cattr(RTTT.PFcol,RTTT.PBCol),Prompt);
  492.       1 : WriteAT(succ(X1),pred(Y),Cattr(RTTT.PFcol,RTTT.PBCol),Prompt);
  493.       2 : WriteAT(X1+width-P,succ(Y),Cattr(RTTT.PFcol,RTTT.PBCol),Prompt);   {right justified in lower border}
  494.    end;
  495.    if InBorder > 0 then        {return var X1 adjusted to position of input field}
  496.    begin
  497.       if Boxtype > 0 then
  498.          X1 := succ(X1);
  499.    end else
  500.    begin
  501.       if Boxtype > 0 then
  502.          X1 := succ(X1) + p
  503.       else
  504.          X1 := X1 + P;
  505.    end;
  506. end; { DisplayBoxAndPrompt }
  507.  
  508. procedure ReadString(X,Y,L: byte; Prompt: StrScreen;
  509.                       BoxType: byte; var Txt: StrScreen);
  510. {}
  511. begin
  512.    DisplayBoxandPrompt(X,Y,Boxtype,Prompt,L);
  513.    ReadLine(X,Y,L,RTTT.FCol,RTTT.BCol,1,Txt);
  514. end; { ReadString }
  515.  
  516. procedure ReadStringUpper(X,Y,L: byte; Prompt: StrScreen;
  517.                             BoxType: byte; var Txt: StrScreen);
  518. {}
  519. begin
  520.    Txt := SetUpper(Txt);
  521.    DisplayBoxandPrompt(X,Y,Boxtype,Prompt,L);
  522.    ReadLine(X,Y,L,RTTT.FCol,RTTT.BCol,2,Txt);
  523. end; { ReadStringUpper }
  524.  
  525. procedure ReadPassword(X,Y,L: byte; Prompt: StrScreen;
  526.                         BoxType: byte; var Txt: StrScreen);
  527. {}
  528. begin
  529.    DisplayBoxandPrompt(X,Y,Boxtype,Prompt,L);
  530.    ReadLine(X,Y,L,RTTT.FCol,RTTT.BCol,11,Txt);
  531. end; { ReadPassword }
  532.  
  533. procedure ReadAlpha(X,Y,L: byte; Prompt: StrScreen;
  534.                      BoxType: byte; var Txt: StrScreen);
  535. {}
  536. begin
  537.    DisplayBoxandPrompt(X,Y,Boxtype,Prompt,L);
  538.    ReadLine(X,Y,L,RTTT.FCol,RTTT.BCol,4,Txt);
  539. end; { ReadAlpha }
  540.  
  541. procedure ReadYN(X,Y: byte; Prompt: StrScreen; BoxType: byte; var Yes: boolean);
  542. {}
  543. var GlobalInsert: boolean;
  544.     Txt: StrScreen;
  545. begin
  546.    if Yes then
  547.       Txt := 'Y'
  548.    else
  549.       Txt := 'N';
  550.    GlobalInsert := RTTT.insert;
  551.    RTTT.Insert := false;            {force to overwrite mode}
  552.    DisplayBoxandPrompt(X,Y,Boxtype,Prompt,1);
  553.    ReadLine(X,Y,1,RTTT.FCol,RTTT.BCol,3,Txt);
  554.    RTTT.Insert := GlobalInsert;    {reset back}
  555.    if Txt = 'Y' then
  556.       Yes := true
  557.    else
  558.       Yes := false;
  559. end; { ReadYN }
  560.  
  561. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  562.  
  563. procedure InvalidMessage(Y: byte; var CH: char);
  564. {}
  565. begin
  566.    Clang;
  567.    TempMessageCH(1,Y,Cattr(RTTT.MsgFcol,RTTT.MsgBCol),
  568.                PadCenter('Invalid number - press any key to resume',80,' '),CH);
  569. end; { InvalidMessage }
  570.  
  571. procedure OutOfRangeMessage(Y: byte; MinS,MaxS: StrScreen; var CH: char);
  572. {}
  573. var S: StrScreen;
  574. begin
  575.    Clang;
  576.    S := 'Error value must be in the range '+MinS+' to '+MaxS+' - press any key to resume';
  577.    TempMessageCh(1,Y,Cattr(RTTT.MsgFcol,RTTT.MsgBCol),PadCenter(S,80,' '),CH);
  578. end; { OutOfRangeMessage }
  579.  
  580. function MessageLine(Y: byte): byte;
  581. {}
  582. begin
  583.    if (RTTT.MsgLine = 0) or (RTTT.MsgLine > HardVars.Depth) then
  584.    begin
  585.       if Y < HardVars.Depth then    {set message Line}
  586.          MessageLine := succ(Y)
  587.       else
  588.          MessageLine := pred(Y);
  589.    end else
  590.       MessageLine := RTTT.MsgLine;
  591. end;  { MessageLine }
  592.  
  593. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  594.  
  595. procedure ReadByte(X,Y,L: byte; Prompt: StrScreen; BoxType: byte;
  596.                     var B: byte; Min, Max: byte);
  597. {}
  598. var Temp: byte;
  599.     Txt: StrScreen;
  600.     Valid: boolean;
  601.     Code: integer;
  602.     YT: byte;
  603.     CHB: char;
  604. begin
  605.    if Max = 0 then
  606.       Max := 255;
  607.    if Min >= Max then
  608.        Min := 0;
  609.    if (B < Min) or (B > Max) then
  610.       B := Min;
  611.    if ((B = 0) and RTTT.SuppressZero) then
  612.       Txt := ''
  613.    else
  614.       Txt := IntToStr(B);
  615.    Temp := B;
  616.    Valid := false;
  617.    DisplayBoxandPrompt(X,Y,Boxtype,Prompt,L);
  618.    YT := MessageLine(Y);
  619.    repeat
  620.       ReadLine(X,Y,L,RTTT.FCol,RTTT.BCol,8,Txt);
  621.       if ((RChar = #027) and RTTT.AllowEsc)
  622.          or ((Txt = '') and (RTTT.AllowNull)) then
  623.       begin
  624.          if Txt = '' then RNull := true;
  625.             exit;
  626.       end else
  627.       begin
  628.          val(Txt,Temp,code);
  629.          if code <> 0 then
  630.          begin
  631.             InvalidMessage(YT,CHB);
  632.             if ChB = #027 then
  633.                Txt := IntToStr(B);
  634.          end else
  635.          begin
  636.             if (Temp < Min)
  637.                or (Temp > Max)
  638.                or ((length(Txt) > 2) and (Txt > '255')) then
  639.             begin
  640.                OutOfRangeMessage(Yt,IntToStr(Min),IntToStr(Max),CHB);
  641.                if ChB = #027 then
  642.                   Txt := IntToStr(B);
  643.             end else
  644.             begin
  645.                B := temp;
  646.                Valid := true;
  647.             end;
  648.          end;
  649.       end;
  650.    until Valid or ((RChar = #027) and RTTT.AllowEsc);
  651. end; { ReadByte }
  652.  
  653. procedure ReadWord(X,Y,L: byte; Prompt: StrScreen; BoxType: byte;
  654.                                     var W: word; Min, Max: word);
  655. {}
  656. var Temp: word;
  657.     Txt: StrScreen;
  658.     Valid: boolean;
  659.     Code: integer;
  660.     YT: byte;
  661.     ChW: char;
  662. begin
  663.    if Max = 0 then
  664.       Max := MaxWord;
  665.    if Min >= Max then
  666.        Min := MinWord;
  667.    if (W < Min) or (W > Max) then
  668.         W := Min;
  669.    if ((W = 0) and RTTT.SuppressZero) then
  670.        Txt := ''
  671.    else
  672.        Txt := IntToStr(W);
  673.    Temp := W;
  674.    Valid := false;
  675.    DisplayBoxandPrompt(X,Y,Boxtype,Prompt,L);
  676.    YT := MessageLine(Y);
  677.    repeat
  678.       ReadLine(X,Y,L,RTTT.FCol,RTTT.BCol,8,Txt);
  679.       if ((RChar = #027) and RTTT.AllowEsc)
  680.       or ((Txt = '') and (RTTT.AllowNull)) then
  681.       begin
  682.          if Txt = '' then RNull := true;
  683.             exit;
  684.       end else
  685.       begin
  686.          val(Txt,Temp,code);
  687.          if code <> 0 then
  688.          begin
  689.             InvalidMessage(YT,ChW);
  690.             if ChW = #027 then
  691.                Txt := IntToStr(W);
  692.          end else
  693.          begin
  694.             if (Temp < Min)
  695.                or (Temp > Max)
  696.                or ((length(Txt) > 4) and (Txt > IntToStr(MaxWord))) then
  697.             begin
  698.                OutOfRangeMessage(Yt,IntToStr(Min),IntToStr(Max),ChW);
  699.                if ChW = #027 then
  700.                   Txt := IntToStr(W);
  701.             end else
  702.             begin
  703.                W := temp;
  704.                Valid := true;
  705.             end;
  706.          end;
  707.       end;
  708.    until Valid  or ((RChar = #027) and RTTT.AllowEsc);
  709. end; { ReadWord }
  710.  
  711. procedure ReadInt(X,Y,L: byte; Prompt: StrScreen; BoxType: byte;
  712.                              var W: integer; Min, Max: integer);
  713. {}
  714. var Temp: integer;
  715.     Txt: StrScreen;
  716.     Valid: boolean;
  717.     Code: integer;
  718.     YT: byte;
  719.     ChI: char;
  720. begin
  721.    if Max = 0 then
  722.       Max := MaxInt;
  723.    if Min >= Max then
  724.        Min := MinInt;
  725.    if (W < Min) or (W > Max) then
  726.         W := Min;
  727.    if ((W = 0) and RTTT.SuppressZero) then
  728.        Txt := ''
  729.    else
  730.        Txt := IntToStr(W);
  731.    Temp := W;
  732.    Valid := false;
  733.    DisplayBoxandPrompt(X,Y,Boxtype,Prompt,L);
  734.    YT := MessageLine(Y);
  735.    repeat
  736.       ReadLine(X,Y,L,RTTT.FCol,RTTT.BCol,5,Txt);
  737.       if ((RChar = #027) and RTTT.AllowEsc)
  738.       or ((Txt = '') and (RTTT.AllowNull)) then
  739.       begin
  740.          if Txt = '' then RNull := true;
  741.             exit;
  742.       end else
  743.       begin
  744.          val(Txt,Temp,code);
  745.          if code <> 0 then
  746.          begin
  747.             InvalidMessage(YT,ChI);
  748.             if ChI = #027 then
  749.                Txt := InttoStr(W);
  750.          end else
  751.          begin
  752.             if (Temp < Min) or (Temp > Max) then
  753.             begin
  754.                OutOfRangeMessage(Yt,IntToStr(Min),IntToStr(Max),ChI);
  755.                if ChI = #027 then
  756.                   Txt := InttoStr(W);
  757.             end else
  758.             begin
  759.                W := temp;
  760.                Valid := true;
  761.             end;
  762.          end;
  763.       end;
  764.    until Valid  or ((RChar = #027) and RTTT.AllowEsc);
  765. end; { ReadInt }
  766.  
  767. procedure ReadLongInt(X,Y,L: byte; Prompt: StrScreen; BoxType: byte;
  768.                                  var W: longint; Min, Max: longint);
  769. {}
  770. var Temp: longint;
  771.     Txt: StrScreen;
  772.     Valid: boolean;
  773.     Code: integer;
  774.     YT: byte;
  775.     ChI: char;
  776. begin
  777.    if Max = 0 then
  778.       Max := MaxLongInt;
  779.    if Min >= Max then
  780.        Min := MinLongInt;
  781.    if (W < Min) or (W > Max) then
  782.         W := Min;
  783.    if ((W = 0) and RTTT.SuppressZero) then
  784.        Txt := ''
  785.    else
  786.        Txt := IntToStr(W);
  787.    Temp := W;
  788.    Valid := false;
  789.    DisplayBoxandPrompt(X,Y,Boxtype,Prompt,L);
  790.    YT := MessageLine(Y);
  791.    repeat
  792.       ReadLine(X,Y,L,RTTT.FCol,RTTT.BCol,5,Txt);
  793.       if ((RChar = #027) and RTTT.AllowEsc)
  794.       or ((Txt = '') and (RTTT.AllowNull)) then
  795.       begin
  796.          if Txt = '' then RNull := true;
  797.             exit;
  798.       end else
  799.       begin
  800.          val(Txt,Temp,code);
  801.          if code <> 0 then
  802.          begin
  803.             InvalidMessage(YT,ChI);
  804.             if ChI = #027 then
  805.                Txt := InttoStr(W);
  806.          end else
  807.          begin
  808.             if (Temp < Min) or (Temp > Max) then
  809.             begin
  810.                OutOfRangeMessage(Yt,IntToStr(Min),IntToStr(Max),ChI);
  811.                if ChI = #027 then
  812.                   Txt := InttoStr(W);
  813.             end else
  814.             begin
  815.                W := temp;
  816.                Valid := true;
  817.             end;
  818.          end;
  819.       end;
  820.    until Valid  or ((RChar = #027) and RTTT.AllowEsc);
  821. end; { ReadLongInt }
  822.  
  823. procedure ReadReal(X,Y,L: byte; Prompt: StrScreen; BoxType: byte;
  824.                                     var W: real; Min, Max: real);
  825. {}
  826. var Temp: Real;
  827.     Txt: StrScreen;
  828.     Valid: boolean;
  829.     Code: integer;
  830.     YT: byte;
  831.     ChR: char;
  832. begin
  833.    if Max = 0 then
  834.       Max := 99999999;
  835.    if Min >= Max then
  836.        Min := -99999999;
  837.    if (W < Min) or (W > Max) then
  838.         W := Min;
  839.    if Min < 0 then    {add room for - sign}
  840.        inc(L);
  841.    if ((W = 0.0) and RTTT.SuppressZero) then
  842.        Txt := ''
  843.    else
  844.        Txt := RealToStr(W,RTTT.RealDP);
  845.    Temp := W;
  846.    Valid := false;
  847.    DisplayBoxandPrompt(X,Y,Boxtype,Prompt,L);      {5.00b}
  848.    YT := MessageLine(Y);
  849.    repeat
  850.       ReadLine(X,Y,L,RTTT.FCol,RTTT.BCol,7,Txt);
  851.       if ((RChar = #027) and RTTT.AllowEsc)
  852.       or ((Txt = '') and (RTTT.AllowNull)) then
  853.       begin
  854.          if Txt = '' then RNull := true;
  855.             exit;
  856.       end else
  857.       begin
  858.          val(Txt,Temp,code);
  859.          if code <> 0 then
  860.          begin
  861.             InvalidMessage(YT,ChR);
  862.             if ChR = #027 then
  863.                Txt := RealtoStr(W,RTTT.RealDP);
  864.          end else
  865.          begin
  866.             if (Temp < Min) or (Temp > Max) then
  867.             begin
  868.                OutOfRangeMessage(Yt,RealToStr(Min,RTTT.RealDP),RealToStr(Max,RTTT.RealDP),ChR);
  869.                if ChR = #027 then
  870.                   Txt := RealtoStr(W,RTTT.RealDP);
  871.             end else
  872.             begin
  873.                W := temp;
  874.                Valid := true;
  875.             end;
  876.          end;
  877.       end;
  878.    until Valid  or ((RChar = #027) and RTTT.AllowEsc);
  879. end; { ReadReal }
  880.  
  881. procedure ReadSelect(X,Y: byte;Pmt,Txt: StrScreen;var Choice: byte);
  882. {}
  883. const
  884.      UpChar: string[1] = '^';
  885.      JoinChar: string[1] = '';
  886. var
  887.   W: byte;
  888.   I: integer;
  889.   Horiz: boolean;
  890.  
  891.      function ReplaceJoinChar(Str: string): string;
  892.      {}
  893.      var I: integer;
  894.      begin
  895.          for I := 1 to length(Str) do
  896.              if Str[I] = JoinChar then
  897.                 Str[I] := ' ';
  898.          ReplaceJoinChar := Str;
  899.      end; { ReplaceJoinChar }
  900.  
  901.      procedure HiLightWord(W: byte;Hi: boolean);
  902.      {}
  903.      var Col: byte;
  904.      begin
  905.         if Hi then
  906.            Col := Cattr(RTTT.HiFCol,RTTT.HiBcol)
  907.         else
  908.            Col := Cattr(RTTT.LoFcol,RTTT.LoBcol);
  909.         if Horiz then
  910.            WriteAT(pred(X)+PosWord(W,Txt),Y,Col,ReplaceJoinChar(ExtractWords(W,1,Txt)))
  911.         else
  912.            WriteAT(X,pred(Y)+W,Col,ReplaceJoinChar(ExtractWords(W,1,Txt)));
  913.         if Hi then
  914.         begin
  915.            if Horiz then
  916.               GotoXY(pred(X)+PosWord(W,Txt),Y)
  917.            else
  918.               GotoXY(X,Pred(Y)+W);
  919.         end;
  920.      end;  { HiLightWord }
  921.  
  922.      procedure ProcessKeys;
  923.      {}
  924.      var ChP: char;
  925.          Finished: boolean;
  926.      begin
  927.         Finished := false;
  928.         repeat
  929.            ChP := getKey;
  930.            if ChP in RTTT.EndChars then
  931.               Finished := True
  932.            else
  933.               case upcase(ChP) of
  934.                  #132,
  935.                  EscKey      : if RTTT.AllowEsc then
  936.                                   Finished := true;
  937.                  ' ',#9,                                 {tab}
  938.                  CursorDown,
  939.                  CursorRight : begin
  940.                                   HiLightWord(Choice,false);
  941.                                   if Choice < W then
  942.                                      inc(Choice)
  943.                                   else
  944.                                      Choice := 1;
  945.                                   HiLightWord(Choice,true);
  946.                                end;
  947.                  #143,                     {Shift tab}
  948.                  CursorUp,
  949.                  CursorLeft  : begin
  950.                                   HiLightWord(Choice,false);
  951.                                   if Choice > 1 then
  952.                                      dec(Choice)
  953.                                   else
  954.                                      Choice := W;
  955.                                   HiLightWord(Choice,true);
  956.                                end;
  957.                  #131        : if (Choice < W) and Horiz then    {mouse right}
  958.                                begin
  959.                                   HiLightWord(Choice,false);
  960.                                   inc(Choice);
  961.                                   HiLightWord(Choice,true);
  962.                                end;
  963.                  #130        : if (Choice > 1) and Horiz then    {mouse left}
  964.                                begin
  965.                                   HiLightWord(Choice,false);
  966.                                   dec(Choice);
  967.                                   HiLightWord(Choice,true);
  968.                                end;
  969.                  #129        : if (Choice < W) and (Horiz = false) then    {mouse down}
  970.                                begin
  971.                                   HiLightWord(Choice,false);
  972.                                   inc(Choice);
  973.                                   HiLightWord(Choice,true);
  974.                                end;
  975.                  #128        : if (Choice > 1) and (Horiz = false) then    {mouse up}
  976.                                begin
  977.                                   HiLightWord(Choice,false);
  978.                                   dec(Choice);
  979.                                   HiLightWord(Choice,true);
  980.                                end;
  981.  
  982.               end; {case}
  983.            until Finished;
  984.            RChar := ChP;
  985.      end;  { ProcessKeys }
  986.  
  987. begin
  988.    if Txt[1] = UpChar then
  989.    begin
  990.       Horiz := False;
  991.       delete(Txt,1,1);
  992.    end else
  993.       Horiz := true;
  994.    W := Wordcnt(Txt);
  995.    if W < 2 then
  996.       exit;              {only show choices if there are two or more}
  997.    CursorFind(CursorX,CursorY,ScanTop,ScanBot);   {record cursor settings}
  998.    if (Choice > W) or (Choice < 1) then           {check that W is sensible}
  999.       Choice := 1;
  1000.    if Pmt <> '' then
  1001.    begin
  1002.       WriteAT(X,Y,Cattr(RTTT.PFcol,RTTT.PBCol),Pmt);
  1003.       X := X+length(Pmt);
  1004.    end;
  1005.    for I := 1 to W do
  1006.        HiLightWord(I,False);
  1007.    CursorOn;
  1008.    HiLightWord(Choice,True);
  1009.    Processkeys;
  1010.    GotoXY(CursorX,CursorY);           {reset cursor}
  1011.    CursorSize(ScanTop,ScanBot);
  1012. end;  { ReadSelect }
  1013.  
  1014. begin
  1015.    DefaultSettings;
  1016. end.
  1017.